! FileM.f 
! Created 8/27/91 9:37 by AppMaker 

!!MP inlines.f
!!G JLtest.finc.f

!!D+
!!R+
!!OV+
!!S FileM 

!----------
	Subroutine InitFileM
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
	dialogTop		= 75
	dialogLeft		= 85

	numOpenTypes = 1
	openTypeList.SFT(0).OST = 'TEXT'
		!add code here: File init
	End !InitFileM

!----------
	Logical Function OkToOpen (fType)
	record /OSType/ fType
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
	integer*2	i, status, searching, found, notFound
	Parameter(searching=0, found=1, notFound=2)

	i = 0
	status = searching
	do while (status = searching)
		if (i >= numOpenTypes) then 
			status = notFound
		else 
			if (fType.OST = openTypeList.SFT(i).OST) then 
				status = found
			else 
				i = i + 1
			end if
		end if
	end do
	OkToOpen = (status = found)
	End !OkToOpen

!----------
	Logical Function OpenApplFile (vRefNum, fName, fRefNum)
	integer*2 vRefNum, fRefNum
	String*255 fName
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
	Logical*2 CheckOS
	logical ok

	!add code here: open a file
	ok = CheckOS (FSOpen (fName, vRefNum, %ref(fRefNum)))
	OpenApplFile = ok
	End !OpenApplFile

!----------
	Subroutine CloseApplFile (fRefNum)
	include 'Globals.inc'
	integer*2 fRefNum
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Logical*2 CheckOS
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
	logical ok
	!add code here: close a file
  	if (cur^.windowKind = 1) then  !1st or only window in set
		ok = CheckOS (FSClose (fRefNum))
	end if
	End !CloseApplFile

!----------
	Subroutine SaveApplFile (fRefNum)
	include 'Globals.inc'
	integer*2 fRefNum
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag

	!add code here: save a file
	cur^.dirty = .false.
	End !SaveApplFile

!----------
	Logical Function ReadApplFile (fRefNum)
	integer*2 fRefNum
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag

	!add code here: read a file
  	ReadApplFile = .false.
	End !ReadApplFile

!----------
	Subroutine DoNew
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
	record /StringHandle/ nameHandle		
	String*255 name

	nameHandle.shdl = GetString (UntitledID)
	name = nameHandle.shdl^.sptr^
	call OpenWindows (name, INT2(0), INT2(0))
	End !DoNew
 
!----------
	Subroutine OpenFile (fileName, vRefNum)
	String*255 fileName
	integer*2 vRefNum, fRefNum
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag

	if (OpenApplFile (vRefNum, fileName, fRefNum)) then 
		Call OpenWindows (fileName, vRefNum, fRefNum)
	end if	
	End !OpenFile
 
!----------
	Subroutine DoOpen
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
	record /point/	dialogOrigin
	record /SFReply/ sfInfo			

	Call SetPt (%ref(dialogOrigin), dialogLeft, dialogTop)
	Call SFGetFile (dialogOrigin, '', nil, numOpenTypes, openTypeList, nil, %ref(sfInfo))
	if (sfinfo.good) then 
		Call openFile (sfinfo.fName, sfinfo.vRefNum)
	end if
	End !DoOpen
 
!----------
	Subroutine Open0Files
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag

	Call DoNew
	End !Open0Files
 
!----------
	Subroutine DoSaveAs
	include 'Globals.inc'
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	record /SFReply/ sfInfo			
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
	integer*2 fRefNum
	logical ok
	record /StringHandle/ prompt, untitled			
	String*255 suggestion
	logical OpenApplFile
	logical*2 CreateFile

	prompt.shdl = GetString (SaveAsPromptID)
	suggestion = ''

		if (CreateFile (sfInfo, prompt.shdl^.sptr^, suggestion, %val('XXXX'), %val('TEXT'))) then 
			if (cur^.fileNum <> 0) then 
				Call CloseApplFile (cur^.fileNum)
			end if
			if (OpenApplFile (sfinfo.vRefNum, sfinfo.fName, fRefNum)) then 
				Call SetWTitle (curWindow, sfinfo.fName)
				cur^.fileNum = fRefNum
				cur^.volNum = sfinfo.vRefNum
				Call SaveApplFile (cur^.fileNum)
			else  !should never happen
				untitled.shdl = GetString (UntitledID)
				Call SetWTitle (curWindow, untitled.shdl^.sptr^)
				cur^.fileNum = 0
				cur^.volNum = 0
			end if
		end if
	End !DoSaveAs
 
!----------
	Subroutine DoSave
	include 'Globals.inc'
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	record /SFReply/ sfInfo			
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo

	if (cur^.fileNum = 0) then 
		Call DoSaveAs
	else 
		Call SaveApplFile (cur^.fileNum)
	end if
	End !DoSave
 
!----------
	Subroutine CloseApplWindow
	include 'Globals.inc'
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	record /SFReply/ sfInfo			
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
	integer*2 saveItem, cancelItem, discardItem
	Parameter(saveItem = 1, cancelItem = 2, discardItem = 3)
	pointer /WindowRecord/ Wpeek
	String*255 curTitle
	integer*2 itemNum
	logical ok
	

	ok = .true.
	Wpeek = FrontWindow()
	If (Wpeek^.windowkind = FORTWindow) then
		Call F_CloseOutPWindow
	else
		Call SetInfo (Wpeek)
		if (cur^.dirty) then 
			Call GetWTitle (curWindow, curTitle)
			Call ParamText (curTitle, '', '', '')
			Call InitCursor
			itemNum = Alert (SaveID, nil)
			Select Case (itemNum)
				Case (saveItem) 
					Call DoSave
					ok = .not. errorFlag
				Case (discardItem)
					   !Do nothing
				Case (cancelItem) 
					errorFlag = .true.
					ok = .false.
			end select
		end if
		if (ok) then 
			if (cur^.fileNum <> 0) then 
				Call CloseApplFile (cur^.fileNum)
			end if
			Call CloseCurWindow
		end if
	end if
	End !CloseApplWindow
 
!----------
	Subroutine DoClose
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	record /SFReply/ sfInfo			
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
	pointer /WindowRecord/ frontPeek		

	errorFlag = .false.

	frontPeek = FrontWindow()
	if (frontPeek^.windowKind < 0) then 
		Call CloseDeskAcc (frontPeek^.windowKind)
	else if (frontPeek^.windowKind = dialogKind) then 
		Call CloseModelessDialog (FrontWindow())
	else 
		Call CloseApplWindow
	end if
	End !DoClose

!----------
	Subroutine DoQuit
	include 'Globals.inc'
	integer*2 dialogTop, dialogLeft
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	record /SFReply/ sfInfo			
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
	logical quitting
	pointer /WindowRecord/ wpeek
	Integer*4 OutputWindow
	External OutputWindow
	
	quitting = .true.
	If (OutputWindow() .NE. nil) Call SendBehind(OutputWindow(),nil)
	do while (quitting .and. (FrontWindow() <> nil)) 
		Wpeek = FrontWindow()
		Call SystemTask
		If (Wpeek^.windowkind = FORTWindow) then
			Call DoMenu('File','Quit')
			Call ExitFORTRAN
		else
			Call DoClose
		end if
		if (errorFlag) then 
			quitting = .false.
		end if
	end do
	
	if (quitting) then 
		quittingTime = .true.
	end if
	End !DoQuit
 
	!----------
	Subroutine DoRevert
	include 'globals.inc'
	String*255	fileName
	Logical	ok, ReadApplFile
	Logical*2 Confirm
	
		ok = .true.
		If (cur^.dirty) then 
			Call GetWTitle (curWindow, fileName)
			Call ParamText (fileName, '', '', '')
			ok = Confirm (RevertID)
		end if
		If (ok) ok = ReadApplFile (cur^.fileNum)

		If (ok) Call InvalRect (curWindow^.portRect)
	End !DoRevert

	!----------
		Subroutine DoPageSetup 
		record /THPrint/ myprintHdl
		common /PrintStuff/ myPrintHdl
		Integer*4 sz
		logical*2 confirmed
		
		sz = Jsizeof(Tprint)
		MyprintHdl.TH = NewHandle(sz)	!grab some memory for the print record
		if (MyprintHdl.TH = nil) Stop "Print Handle not allocated!"
		call propen	!Start Printing
		confirmed=PrStlDialog(MyprintHdl)
		If (.not. confirmed) then
			Call DisposHandle(MyprintHdl)
			MyprintHdl.TH = nil
		end if
		call prclose
		!add code here: PageSetup action
		End !DoPageSetup 


!----------
	Subroutine DoPrint 
	!add code here: Print action
	End !DoPrint 

!----------
	Subroutine DoFile (itemNr)
	integer*2 dialogTop, dialogLeft, itemNr
	integer*2 numOpenTypes
	record /SFTypeList/ openTypeList
	logical errorflag
	record /SFReply/ sfInfo			
	Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo

	errorFlag = .false.

	select case (itemNr)
		case(FileNew)
			Call DoNew 
		
		case(FileOpen)
			Call DoOpen 
		
		case(FileClose)
			Call DoClose 
		
		case(FileSave)
			Call DoSave 
		
		case(FileSaveAs)
			Call DoSaveAs 
		
		case(FileRevert)
			Call DoRevert 
		
		case(FilePageSetup)
			Call DoPageSetup 
		
		case(FilePrint)
			Call DoPrint 
		
		case(FileQuit)
			Call DoQuit 
		
		 
	end select
	End !DoFile 
